Tech Arsenal 2/Tech Arsenal 2 (Arsenal Computer).iso/clipper/s93bsp.exe/S87/INV00.PRG

Text File | 1993-11-12 | 13.5 KB | 515 lines

procedure INVMAIN
*       I N V 0 0
*       Main controlling routine for Invoices
private INVCOM, PINVNO
store 0 to PINVNO, INVCOM

select 0
use INVOICE index INVNUM alias INVOICE
select 0
use PARTS index PARTINV
select 0
use PARTLINE
set deleted on
QBCHOICE = 1
do INVSAY with .f.

do while .t.

    INVCLEAR()
    do INVGET with .f.
    select PARTLINE
    zap
    do PARTSHOW with 15,1,10
    select INVOICE
    do INVTOT
    INVCOM = QBPROMPT("Add|Edit|Delete|Print|Quit|","Add a new invoice, or Fetch existing")

    PINVNO = MINVNO
    do case
    case INVCOM=1                  && Add
        MEDITING = .f.
        do INVEDIT with 0
    case INVCOM=2                  && Edit
        INVFIND(.t.)
        if MINVNO>0
            MEDITING = .t.
            PINVNO = MINVNO
            do INVEDIT with PINVNO
        endif
    case INVCOM=3                  && Delete
        INVFIND(.f.)
        if MINVNO>0
            PINVNO = MINVNO
            do INVDEL with PINVNO
        endif
    case INVCOM=4                  && Print
        INVFIND(.f.)
        if MINVNO>0
            PINVNO = MINVNO
            do INVOUT with PINVNO
        endif
    case INVCOM=5 .or. INVCOM=0
        exit
    endcase
    QBCHOICE = 4
enddo
close database

return

******************************************************************

procedure INVEDIT
*   I N V E D I T
parameters PINVNO
private IACTION, EACTION, INVSTAT, DEFCOM

select INVOICE
INVSTAT = 0
if PINVNO=0
    MINVNO = INVADD(0)
    IACTION = 99
    EACTION = 1
else
    IACTION = 2
    EACTION = 0
endif
if MINVNO=0
    return
endif
DEFCOM = 4
do while .t.

*   Get headers etc
    SINVNO()
    if IACTION=0
        IACTION = QBPROMPT("Save|Edit|Abandon|Print|Renumber|Quit|","Actions on this Invoice, Exit",DEFCOM)
        DEFCOM = IACTION
    endif

    do case
    case IACTION=1
        INVSTAT = INVSAVE()
        store 0 to IACTION, EACTION
        DEFCOM = 6
    case IACTION=2
        EACTION = QBPROMPT("Owner|Credit terms|Insurance/Labour|Vehicle/Dates|Parts/Paint etc|Quit|",;
                  "Select Invoice area to update",EACTION+1)
        INVSTAT = 1
        DEFCOM = 1
    case IACTION=3
        INVSTAT = INVFILL(.t.)
        do INVGET with .f.
        do PARTSHOW with 15,1,10
        do INVTOT
        store 0 to IACTION, EACTION
        if MINVNO=0
           do QBMESS with "Invoice not present in Database - returning",colflash,5
           return
        endif
    case IACTION=4
        do INVOUT with (MINVNO)
        store 0 to IACTION, EACTION
    case IACTION=5
        do INVREN
        store 0 to IACTION, EACTION
    case IACTION=6 .or. IACTION=0       && MIB 23/10/90
        if INVSTAT=1 .and. MINVTOTAL>0
            do QBMESS with "Invoice changed - Save or Abandon first",colhead,5
            store 0 to IACTION, EACTION
        else
            do invclear                && MIB 23/10/90
            do INVSAY with .f.
            exit
        endif
    endcase

    GETOUT = .f.
    do case
    case EACTION=1             && Owner
        do INVGET with .t.
        IACTION = 2            && Get back to the right menu in Add mode
    case EACTION=2             && Payment
        do INVPAY with .t.
    case EACTION=3             && Insurance/Labour
        do INVINSLB with .t.
    case EACTION=4             && Vehicle
        do INVVEH with .t.
    case EACTION=5             && Parts
        do PARTEDIT with 15,1,10,PINVNO
        do PARTSHOW with 15,1,10
    endcase
    do INVTOT

    if GETOUT .or. EACTION=6 .or. EACTION=0
        store 0 to IACTION, EACTION
    endif
enddo

return

******************************************************************

function INVFILL
parameters DOPART
*       I N V F I L L

MINVNO     = INVOICE->INVNO
MSPEEDO    = INVOICE->SPEEDO
MFUEL      = INVOICE->FUEL
MPARTDISC  = INVOICE->PARTDISC
MVATRATE   = INVOICE->VATRATE
MOWNNAME   = INVOICE->OWNNAME
MOWNINIT   = INVOICE->OWNINIT
MOWNADD1   = INVOICE->OWNADD1
MOWNADD2   = INVOICE->OWNADD2
MOWNADD3   = INVOICE->OWNADD3
MMAKEMODEL = INVOICE->MAKEMODEL
MINSCO     = INVOICE->INSCO
MINSADD1   = INVOICE->INSADD1
MINSADD2   = INVOICE->INSADD2
MINSENG    = INVOICE->INSENG
MINSTEL    = INVOICE->INSTEL
MPAINT     = INVOICE->PAINT
MTRIM      = INVOICE->TRIM
MOWNTELH   = INVOICE->OWNTELH
MOWNTELB   = INVOICE->OWNTELB
MOWNVAT    = INVOICE->OWNVAT
MINSTOPAY  = INVOICE->INSTOPAY
MACTYPE    = INVOICE->ACTYPE
MWORKTYPE  = INVOICE->WORKTYPE
MDATEIN    = INVOICE->DATEIN
MDATEOUT   = INVOICE->DATEOUT
MDATEINV   = INVOICE->DATEINV
MREGNO     = INVOICE->REGNO
MYEAR      = INVOICE->YEAR
MENGNO     = INVOICE->ENGNO
MCHASNO    = INVOICE->CHASNO
MESTNO     = INVOICE->ESTNO
MLABESTNO  = INVOICE->LABESTNO
MCLAIMNO   = INVOICE->CLAIMNO
MLABOUR1   = INVOICE->LABOUR1
MLABOUR2   = INVOICE->LABOUR2
MLABOUR3   = INVOICE->LABOUR3
MLABOUR4   = INVOICE->LABOUR4
MLABOURT   = INVOICE->LABOURT
MINSLAB    = INVOICE->INSLAB
MOWNLAB    = INVOICE->OWNLAB
MINSPART   = INVOICE->INSPART
MOWNPART   = INVOICE->OWNPART
MINSSPEC   = INVOICE->INSSPEC
MOWNSPEC   = INVOICE->OWNSPEC
MINSAMT    = INVOICE->INSAMT
MOWNAMT    = INVOICE->OWNAMT
MEXCESS    = INVOICE->EXCESS
MCONTRIB   = INVOICE->CONTRIB
MINSDUE    = INVOICE->INSDUE
MOWNDUE    = INVOICE->OWNDUE
MINVTOTAL  = INVOICE->INVTOTAL
MCUSTTYP   = INVOICE->CUSTTYPE
ML2TEXT    = INVOICE->L2TEXT
ML3TEXT    = INVOICE->L3TEXT
ML4TEXT    = INVOICE->L4TEXT

if DOPART
    PSTAT = PARTLOAD(MINVNO)
endif
return iif(MINVNO=0,0,2)

******************************************************************

function INVCLEAR

*       I N V C L E A R
private OLDINVNO
OLDINVNO = MINVNO

store 0 to MINVNO, MSPEEDO, MFUEL, MPARTDISC
store 0.00 to MLABOUR1, MLABOUR2, MLABOUR3, MLABOUR4, MLABOURT, MINSLAB, MOWNLAB, MINSPART, MOWNPART
store 0.00 to MINSSPEC, MOWNSPEC, MINSAMT, MOWNAMT, MEXCESS, MCONTRIB, MINSDUE, MOWNDUE, MINVTOTAL
store 0.00 TO IPDSCNT, OPDSCNT, ISUBTOT, OSUBTOT, IVATAMT, OVATAMT, INSSUB, OWNSUB
MVATRATE = QBVAT

store space(30) to MOWNADD1, MOWNADD2, MOWNADD3, MMAKEMODEL, MINSCO, MINSADD1, MINSADD2, MINSENG, MINSTEL
store space(30) to ML2TEXT, ML3TEXT, ML4TEXT, MENGNO, MCHASNO
store space(24) to MOWNNAME
store space(15) to MCLAIMNO
store space(12) to MPAINT, MTRIM
store space(12) to MOWNTELH, MOWNTELB, MESTNO, MLABESTNO
store space(8)  to MREGNO
store space(7)  to MYEAR
store space(6)  to MOWNINIT
store space(4)  to MCUSTTYP
store space(1)  to MACTYPE, MWORKTYPE

store .f. to MOWNVAT, MINSTOPAY

store date() to MDATEIN
store ctod("") to MDATEOUT, MDATEINV

return (OLDINVNO)

******************************************************************

function INVADD
*       get a new invoice number
parameters NEWINV
private INVACT
parameters NEWINV
GETOUT = .f.

select PARTLINE
zap
select INVOICE
INVACT = QBPROMPT("Automatic|Manual|","Choose Method of generating new Invoice - ESC to Quit",1)
do case
case INVACT=0 .or. GETOUT
    return 0
case INVACT=1
*   Get new Invoice number
    AUTOADD = .t.
    do INVNEW with .f.
case INVACT=2
    @ 2,73 get MINVNO picture "99999" valid NEWNUM(.t.)
    do QBREAD with "Input new Invoice number","It must not already exist"
    AUTOADD = .f.
    if GETOUT
        MINVNO =  0
    endif
endcase

MINVNO = INVCLEAR()
return  (MINVNO)

******************************************************************

function INVSAVE

*       I N V S A V E
private PINVNO, GO_REC
select INVOICE
use INVOICE
set softseek off
set index to INVNUM, INVDATE, INVCUST, INVNAME
seek str(MINVNO,5)
if eof()
    if AUTOADD
        do INVNEW with .t.
    endif
    select INVOICE
    go top
    if INVOICE->INVNO<>0 .or. reccount()=0
        do QBADBLNK with 10
        go top
    endif

endif

replace INVOICE->INVNO with MINVNO, INVOICE->SPEEDO with MSPEEDO, INVOICE->FUEL with MFUEL, INVOICE->PARTDISC with MPARTDISC
replace INVOICE->VATRATE with MVATRATE, INVOICE->OWNNAME with MOWNNAME, INVOICE->OWNADD1 with MOWNADD1, INVOICE->OWNADD2 with MOWNADD2
replace INVOICE->OWNADD3 with MOWNADD3, INVOICE->MAKEMODEL with MMAKEMODEL, INVOICE->INSCO with MINSCO, INVOICE->INSADD1 with MINSADD1
replace INVOICE->INSADD2 with MINSADD2, INVOICE->INSENG with MINSENG, INVOICE->INSTEL with MINSTEL, INVOICE->PAINT with MPAINT
replace INVOICE->OWNTELH with MOWNTELH, INVOICE->OWNTELB with MOWNTELB, INVOICE->OWNVAT with MOWNVAT, INVOICE->INSTOPAY with MINSTOPAY
replace INVOICE->ACTYPE with MACTYPE, INVOICE->WORKTYPE with MWORKTYPE, INVOICE->TRIM with MTRIM
replace INVOICE->DATEIN with MDATEIN, INVOICE->DATEOUT with MDATEOUT, INVOICE->DATEINV with MDATEINV
replace INVOICE->REGNO with MREGNO, INVOICE->YEAR with MYEAR, INVOICE->ENGNO with MENGNO
replace INVOICE->CHASNO with MCHASNO, INVOICE->ESTNO with MESTNO, INVOICE->LABESTNO with MLABESTNO, INVOICE->CLAIMNO with MCLAIMNO
replace INVOICE->LABOUR1 with MLABOUR1, INVOICE->LABOUR2 with MLABOUR2, INVOICE->LABOUR3 with MLABOUR3, INVOICE->LABOUR4 with MLABOUR4
replace INVOICE->LABOURT with MLABOURT, INVOICE->INSLAB with MINSLAB, INVOICE->OWNLAB with MOWNLAB, INVOICE->INSPART with MINSPART
replace INVOICE->OWNPART with MOWNPART, INVOICE->INSSPEC with MINSSPEC, INVOICE->OWNSPEC with MOWNSPEC, INVOICE->INSAMT with MINSAMT
replace INVOICE->OWNAMT with MOWNAMT, INVOICE->EXCESS with MEXCESS, INVOICE->CONTRIB with MCONTRIB, INVOICE->INSDUE with MINSDUE
replace INVOICE->OWNDUE with MOWNDUE, INVOICE->INVTOTAL with MINVTOTAL
replace INVOICE->CUSTTYPE with MCUSTTYP, INVOICE->OWNINIT with MOWNINIT
replace INVOICE->L2TEXT with ML2TEXT, INVOICE->L3TEXT with ML3TEXT, INVOICE->L4TEXT with ML4TEXT
GO_REC = recno()
set index to INVNUM
go GO_REC

*       Partline save goes in here
PINVNO = MINVNO
do PARTSAVE with PINVNO

select INVOICE

return iif(MINVNO=0,0,2)

******************************************************************

function INVFIND
parameters OKNEW
private ISTAT
ISTAT = 0
GETOUT = .f.

MINVNO = GINVNO(OKNEW)

if MINVNO<>0
    SINVNO()
    ISTAT = INVFILL(.t.)
    do INVGET with .f.
    do PARTSHOW with 15,1,10
    do INVTOT
endif

return ISTAT

******************************************************************

procedure INVDEL
parameters PINVNO

if QBYESNO("Delete this Invoice?")="Y"
    select INVOICE
    set index to INVNUM, INVDATE, INVCUST, INVNAME
    seek str(PINVNO,5)
    if found()
        do QBWIPE
        do PARTDEL with PINVNO
        INVCLEAR()
    endif
    set index to INVNUM
else
    do QBMESS with "Invoice retained",COLFLASH,5
endif

RETURN

******************************************************************

procedure INVTOTAL
parameters DOPART
*   Sum of the parts
*   Sum of specialist
if DOPART
    select PARTLINE
    if reccount()>0
        set deleted on
        sum TPRICE to SUMPART && for PARTSPEC="P" .or. PARTSPEC=" "
    else
        store 0 to SUMPART    &&, SUMSPEC
    endif
    if MINSTOPAY
        MINSPART = SUMPART
        store 0 to MOWNPART, MOWNSPEC
    else
        MOWNPART = SUMPART
        store 0 to MINSPART, MINSSPEC
    endif
    select INVOICE
endif


if MINSTOPAY
    store 0 to MOWNLAB, MOWNPART, MOWNSPEC, OSUBTOT, OPDSCNT, MOWNAMT
    MINSLAB = MLABOURT
    MINSAMT = MINSLAB + MINSPART + MINSSPEC
    IPDSCNT = MINSPART * MPARTDISC / 100
    ISUBTOT = MINSAMT - IPDSCNT
    if MOWNVAT
        IVATAMT = 0
        OVATAMT = ISUBTOT * (MVATRATE / 100)
    else
        IVATAMT = ISUBTOT * (MVATRATE / 100)
        OVATAMT = 0
    endif
    INSSUB  = ISUBTOT + IVATAMT
    MINSDUE = max((INSSUB - MEXCESS - MCONTRIB),0)
    OWNSUB = min(MEXCESS + MCONTRIB,ISUBTOT)
    MOWNDUE = OVATAMT + OWNSUB
else
    store 0 to MINSLAB, MINSPART, MINSSPEC, MCONTRIB, MEXCESS, ISUBTOT, IPDSCNT, MINSDUE, MINSAMT, INSSUB
    MOWNLAB = MLABOURT
    MOWNAMT = MOWNLAB + MOWNPART + MOWNSPEC
    OPDSCNT = MOWNPART * MPARTDISC / 100
    OSUBTOT = MOWNAMT - OPDSCNT
    OVATAMT = OSUBTOT * (MVATRATE / 100)
    OWNSUB = OSUBTOT
    MOWNDUE = OSUBTOT + OVATAMT
endif

return

**************************************************************

procedure INVREN
*   Renumber an Invoice
private OLDNUM, GO_REC
OLDNUM = MINVNO
store 0 to MINVNO

do QBCLMESS
select INVOICE

@ 2,0 say "Old Invoice number: "+str(OLDNUM,5)
@ 2,53 say "New invoice number: "
do while .t.
    @ 2,73 get MINVNO picture "99999" valid NEWNUM(.t.)
    do QBREAD with "Input NEW Invoice number",""
    if GETOUT
        MINVNO = OLDNUM
        return
    endif
    if QBYESNO("New Number OK?")="Y"
        exit
    endif
enddo

*   renumber the Invoice

do QBMESS with "Renumbering Invoice and Parts",colflash,0

GO_REC = recno()
set index to INVNUM, INVDATE, INVCUST, INVNAME
seek str(OLDNUM,5)
if .not. eof()
    replace INVOICE->INVNO with MINVNO
endif
set index to INVNUM
go GO_REC

*    do the  Parts (like delete)
select PARTS
seek str(OLDNUM,5)
do while .not. eof()
    replace PARTS->INVNO with MINVNO
    seek str(OLDNUM,5)
enddo

select partline
replace INVNO with MINVNO all

do QBCLMESS
@ 2,0 clear to 2,79
@ 02,61 say "Invoice no:"
@ 2, 73 say MINVNO picture "99999"

return

**************************************************************

procedure INVNEW
parameters DOIT

select 0
use QBINFO index QBINFO
seek "LASTINV"
if DOIT
    replace QBTEXT with str(MINVNO,5)
else
    if found()
       MINVNO = val(trim(QBTEXT)) + 1
       do while .not. NEWNUM(.f.)
            MINVNO = MINVNO + 1
       enddo
    else
       MINVNO = 1000
       append blank
       replace QBINFKEY with "LASTINV"
    endif
endif
use

return